home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 15 / BBS in a box XV-1.iso / Files / Educ / Calc / MathPad 2.35.sit / XFuns / XFun kit / histogram.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-04-23  |  1.7 KB  |  73 lines  |  [TEXT/KAHL]
  1. /* an example of an XFun that operates on arrays. Accumulates a histogram given an array
  2.    of values. */
  3.  
  4. #include "callback.h"
  5.  
  6. static BOOL histogram(extended *retval,funptr callback)
  7. {
  8.    EXPR arr;
  9.    extended *iptr,*bins,num,binlo,binhi,scl;
  10.    long ndata,i,nbins;
  11.    extended sum;
  12.    BOOL isarray;
  13.  
  14.    if(!GetParmVal(2,&binlo,callback)) return(FALSE);
  15.    if(!GetParmVal(1,&binhi,callback)) return(FALSE);
  16.    if(!GetParmVal(0,&num,callback)) return(FALSE);
  17.    nbins = num;
  18.    if(nbins <= 0 || binlo == binhi)
  19.    {
  20.     ErrMsg(" illegal parameter value",0,callback);
  21.     return(FALSE);
  22.    }
  23.    
  24.    MakeParmExpr(3,&arr,callback);
  25.    ProbeExpr(arr,&num,&isarray,&ndata,callback);
  26.    if(!isarray || !ndata)        /* expecting a finite array */
  27.    {
  28.     ErrMsg(" histogram(?,…) array size?",0,callback);
  29.     FreeExpr(arr,callback);
  30.     return(FALSE);
  31.    }
  32.  
  33.    scl = nbins/(binhi-binlo);
  34.    bins = (extended *)NewPtrClear(nbins*sizeof(extended));
  35.    if(!bins)
  36.    {
  37.     ErrMsg(" not enough memory",0,callback);
  38.     return(FALSE);
  39.    }
  40.    
  41.    AddIndex(&arr,&iptr,callback);
  42.    
  43.    sum = 0;
  44.    *retval = 0;
  45.    *iptr = 1;
  46.    while(ndata--)
  47.    {
  48.     if(EvalExpr(arr,&num,callback))        /* evaluate arr[*iptr] */
  49.     {
  50.      i = (num-binlo)*scl;
  51.      if(i>=0 && i<nbins)
  52.      {
  53.       bins[i] += 1;
  54.       *retval += 1;                /* function return value is total points within range */
  55.       sum += num;
  56.      }
  57.     }
  58.     *iptr += 1;
  59.     if(Stopped(callback)) break;            /* exit loop if problems */
  60.    }
  61.    FreeExpr(arr,callback);
  62.    SetVarMatrix("bins",bins,nbins,0,callback);    /* return histogram in global array "bins" */
  63.    SetVarVal("mean",sum/ *retval,callback);        /* return mean in global "mean" */
  64.    return(TRUE);
  65. }
  66.  
  67. main(funptr callback)
  68. {
  69.    AddXfun("histogram","array,lo,hi,nbins",&histogram,0,callback);
  70. }
  71.  
  72.  
  73.